SuperHack/SuperHack CD.bin/CODING/SOUND/FM-EXT21.ZIP/SOURCE/ENHDOS.PAS

Pascal/Delphi Source File | 1995-06-05 | 79.9 KB | 3,193 lines

Unit EnhDOS;
(*
  Borland Pascal 7.0 (7.01)
  Enhanced DOS interface unit for DOS 3.1+ ***  Version 1.7  April, 1995.
  Copyright (c) 1994,95 by Andrew Eigus. This version is Public Domain.
  The only restriction to this code:
    - Please do not modify copyrights. :) Just a megawish. ;)

  Copyright notes:
    Runtime Library  Copyright (c) 1991,92 Borland International
    GetDriveType portions  Copyright (c) 1994 by Bobby Z.

  EnhDOS unit is fully compatible and can be used for DOS/Windows/DPMI
  targets. If you have any questions, suggestions or bug reports, please
  send mail to [e-mail] or [e-mail] via
  Internet or to 2:5100/33 via Fidonet. Thank you for using EnhDOS!
*)

interface

{#Z+}

(******* General notes

 You are allowed to modify the entire code, however, my advise would be not
 to do this...

 This unit is fully compatible with D.J. Murdoch's ScanHelp utility
 version 3.0 or later. Use ScanHelp to compile this source to a .TPH
 format help file.

 Procedures and functions ending with character '_' work with Pascal-type
 strings rather than with null-terminated PChar-type strings.

 ******* End of general notes *)

{$X+} { Enable extended syntax }
{$I-} { Disable I/O checking }
{$S-} { Disable stack overflow checking }
{$W-} { Disable generation of a special code for FAR procedures/functions }
{$IFDEF P286}
{$G+} { Enable 286 code generation if P286 located in conditional defines }
{$ENDIF}
{$IFDEF P386}
{$G+} { Enable 286 code generation if P386 located in conditional defines }
{$ENDIF}

{$IFDEF Windows}
uses WinTypes, WinProcs, Strings, WinAPI;
{$DEFINE ProtectedMode}
{$ENDIF}

{$IFDEF DPMI}
uses Strings, WinAPI;
{$DEFINE ProtectedMode}
{$ENDIF}

{$IFNDEF ProtectedMode}
uses Strings;
{$ENDIF}

{#Z-}

const
  omRead           = $00; { Open file for input only }
  omWrite          = $01; { Open file for output only }
  omReadWrite      = $02; { Open file for input or/and output (both modes) }
  omShareCompat    = $00;
  omShareExclusive = $10;
  omShareDenyWrite = $20;
  omShareDenyRead  = $30;
  omShareDenyNone  = $40;

  {#T omXXX}
  {#X omRead}{#X omWrite}{#X omReadWrite}
  {#X omShareCompat}{#X omShareExclusive}{#X omShareDenyWrite}{#X omShareDenyRead}{#X omShareDenyNone}

  { Handle file open modes. Used by the #h_OpenFile# function }

  fsPathName       = 79;
  fsDirectory      = 64;
  fsFileSpec       = 12;
  fsFileName       = 8;
  fsExtension      = 4;

  {#T fsXXX}
  {#X fsPathName}{#X fsDirectory}{#X fsFileSpec}{#X fsFileName}{#X fsExtension}
  { Maximum file-name component string lengths used by the #FileSearch# and
    #FileExpand# functions }

  fcExtension      = $0001;
  fcFileName       = $0002;
  fcDirectory      = $0004;
  fcWildcards      = $0008;

  {#T fcXXX}
  {#X fcExtension}{#X fsFileName}{#X fcDirectory}{#X fcWildcards}
  { These constants are used by the #FileSplit# function. The returned value
    is a combination of the fcDirectory, fcFileName, and fcExtension bit
    masks. The value indicates which components were present in the path.
    If the name or extension contains any wildcard characters (* or ?), the
    fcWildcards flag is set }

  faNormal         = $00;
  faReadOnly       = $01;
  faHidden         = $02;
  faSysFile        = $04;
  faVolumeID       = $08;
  faDirectory      = $10;
  faArchive        = $20;
  faAnyFile        = $3F;

  Normal           = $00;
  ReadOnly         = $01;
  Hidden           = $02;
  SysFile          = $04;
  VolumeID         = $08;
  Directory        = $10;
  Archive          = $20;
  AnyFile          = $3F;

  {#T faXXX}
  {#X faNormal}{#X faReadOnly}{#X faHidden}{#X faSysFile}{#X faVolumeID}
  {#X faDirectory}{#X faArchive}{#X faAnyFile}
  { These constants test, set, and clear file-attribute bits in connection with
    the #GetFileAttr#, #SetFileAttr#, #FindFirst#, and #FindNext# procedures.
    These constants are additive. The faAnyFile constant is the sum of all
    attributes }

  skStart = 0; { Seek position relative to the start of a file }
  skPos   = 1; { Seek position relative to a current file position }
  skEnd   = 2; { Seek position relative to the end of a file }

  {#T skXXX}
  {#X skStart}{#X skPos}{#X skEnd}
  { These constants define position relative to what seek the file pointer.
    They are only used in the #h_LSeek# function }

  hStdInput   = 0; { Standard input device }
  hStdOutput  = 1; { Standard output device }
  hStdAUX     = 3; { Standard AUX device (COM1) }
  hStdPrinter = 4; { Standard Printer device (LPT1) }

  {#T hXXX}
  {#X hStdInput}{#X hStdOutput}{#X hStdAUX}{#X hStdPrinter}
  { These constants are the standard I/O device handle numbers. They can be
    used in connection with the #h_OpenFile#, #h_DupHandle#, #h_ForceDup#
    and other handle functions. Use them to access the standard I/O devices }

  frOk    = 0;
  { Continue program. If you return this value, the calling function simply
    terminates. This is the default return value for all the functions
    supported by the #DefaultErrorProc# function }
  frRetry = 1;
  { Retry the action. If you return this value, the calling function will
    be forced to be executed once again. }

  {#T frXXX}
  {#X frOk}{#X frRetry}
  { The frXXX constants are used in connection with the #DefaultErrorProc#
    function. They determine the behaviour that should be followed after
    an EnhDOS function results an error. In such case, the standard error
    handler function is called and its result code is used to determine
    if a function should terminate normally, or it is supposed to retry
    the action.

    The DefaultErrorProc function executes once an error is occured. You
    should check calling function number that caused an error that is passed
    in an argument, and return one of the frXXX constants.

    See: #fnXXX#-constants (function codes)
  }

  {#T DefaultErrorProc}
  {#X frXXX}{#X TErrorFunc}
  { This is standard error handler function that is called whenever error
    occurs in one of the EnhDOS routines. You may set your own error handler
    by using the #SetErrorHandler# procedure }

  fnGetDPB         = $3200;
  fnDiskSize       = $3600;
  fnDiskFree       = $3601;
  fnGetCountryInfo = $3800;
  fnSetDate        = $2B00;
  fnSetTime        = $2D00;
  fnCreateDir      = $3900;
  fnRemoveDir      = $3A00;
  fnGetCurDir      = $4700;
  fnSetCurDir      = $3B00;
  fnDeleteFile     = $4100;
  fnRenameFile     = $5600;
  fnGetFileAttr    = $4300;
  fnSetFileAttr    = $4301;
  fnFindFirst      = $4E00;
  fnFindNext       = $4F00;
  fnCreateFile     = $5B00;
  fnCreateTempFile = $5A00;
  fnOpenFile       = $3D00;
  fnDupHandle      = $4500;
  fnForceDup       = $4600;
  fnRead           = $3F00;
  fnWrite          = $4000;
  fnFlush          = $6800;
  fnLSeek          = $4200;
  fnGetFTime       = $5700;
  fnSetFTime       = $5701;
  fnCloseFile      = $3E00;
  fnDosGetMem      = $4800;
  fnDosFreeMem     = $4900;
  fnDosResize      = $4A00;

  {#T fnXXX}
  { fnXXX-constants are function codes that are passed to error handler
    routine when an error occurs in EnhDOS function. This is list of them:

    #fnGetDPB#,
    #fnDiskSize#,
    #fnDiskFree#,
    #fnGetCountryInfo#,
    #fnSetDate#,
    #fnSetTime#,
    #fnCreateDir#,
    #fnRemoveDir#,
    #fnGetCurDir#,
    #fnSetCurDir#,
    #fnDeleteFile#,
    #fnRenameFile#,
    #fnGetFileAttr#,
    #fnSetFileAttr#,
    #fnFindFirst#,
    #fnFindNext#,
    #fnCreateFile#,
    #fnCreateTempFile#,
    #fnOpenFile#,
    #fnDupHandle#,
    #fnForceDup#,
    #fnRead#,
    #fnWrite#,
    #fnFlush#,
    #fnSeek#,
    #fnGetFTime#,
    #fnSetFTime#,
    #fnCloseFile#,
    #fnDosGetMem#,
    #fnDosFreeMem#,
    #fnDosResize#
 }

  dosrOk                = 0;     { Success }
  dosrInvalidFuncNumber = 1;     { Invalid DOS function number }
  dosrFileNotFound      = 2;     { File not found }
  dosrPathNotFound      = 3;     { Path not found }
  dosrTooManyOpenFiles  = 4;     { Too many open files }
  dosrFileAccessDenied  = 5;     { File access denied }
  dosrInvalidFileHandle = 6;     { Invalid file handle }
  dosrMemCtlBlksKilled  = 7;     { Memory control blocks destroyed }
  dosrNotEnoughMemory   = 8;     { Not enough memory }
  dosrInvalidEnvment    = 10;    { Invalid environment }
  dosrInvalidFormat     = 11;    { Invalid format }
  dosrInvalidAccessCode = 12;    { Invalid file access code }
  dosrInvalidDrive      = 15;    { Invalid drive number }
  dosrCantRemoveDir     = 16;    { Cannot remove current directory }
  dosrCantRenameDrives  = 17;    { Cannot rename across drives }
  dosrNoMoreFiles       = 18;    { No more files }
  dosrFCB29Error        = $FF29; { Fn 29h: Invalid drive ID in filespec }
  dosrFCB11Error        = $FF11; { Fn 11h: No matching files }

  {#T dosrXXX}
  { Standard DOS 3.x+ and few custom error codes reported by the #DOSResult#
    variable:

    #dosrOk#,
    #dosrInvalidFuncNumber#,
    #dosrFileNotFound#,
    #dosrPathNotFound#,
    #dosrTooManyOpenFiles#,
    #dosrFileAccessDenied#,
    #dosrInvalidFileHandle#,
    #dosrMemCtlBlksKilled#,
    #dosrNotEnoughMemory#,
    #dosrInvalidEnvment#,
    #dosrInvalidFormat#,
    #dosrInvalidAccessCode#,
    #dosrInvalidDrive#,
    #dosrCantRemoveDir#,
    #dosrCantRenameDrives#,
    #dosrNoMoreFiles#,
    #dosrFCB29Error#,
    #dosrFCB11Error#
  }

type

  TPathStr = array[0..fsPathName] of Char;
  TDirStr  = array[0..fsDirectory] of Char;
  TNameStr = array[0..fsFileName] of Char;
  TExtStr  = array[0..fsExtension] of Char;
  TFileStr = array[0..fsFileSpec] of Char;

  PathStr = string[fsPathName];
  DirStr  = string[fsDirectory];
  NameStr = string[fsFileName];
  ExtStr  = string[fsExtension];
  FileStr = string[fsFileSpec];

  {#T TDiskParamBlock}
  {#X GetDPB}

  PDiskParamBlock = ^TDiskParamBlock;
  TDiskParamBlock = record
    Drive : byte;             { Disk drive number (0=A, 1=B, 2=C...) }
    SubunitNum : byte;        { Sub-unit number from driver device header }
    SectSize : word;          { Number of bytes per sector }
    SectPerClust : byte;      { Number of sectors per cluster -1
                                (max sector in cluster) }
    ClustToSectShft : byte;   { Cluster-to-sector shift }
    BootSize : word;          { Reserved sectors (boot secs; start of root dir }
    FATCount : byte;          { Number of FATs }
    MaxDir : word;            { Number of directory entries allowed in root }
    DataSect : word;          { Sector number of first data cluster }
    Clusters : word;          { Total number of allocation units (clusters)
                                +2 (number of highest cluster) }
    FATSectors : byte;        { Sectors needed by first FAT }
    RootSect : word;          { Sector number of start of root directory }
    DeviceHeader : pointer;   { Address of device header }
    Media : byte;             { Media descriptor byte }
    AccessFlag : byte;        { 0 if drive has been accessed, FFh - if not }
    NextPDB : PDiskParamBlock { Address of next DPB (0FFFFh if last) }
  end;

  {#T TDiskAllocInfo}
  {#X GetDriveAllocInfo}

  PDiskAllocInfo = ^TDiskAllocInfo;
  TDiskAllocInfo = record
    FATId : byte;             { FAT Id }
    Clusters : word;          { Number of allocation units (clusters) }
    SectPerClust : byte;      { Number of sectors per cluster }
    SectSize : word           { Number of bytes per sector }
  end;

  {#T TCountryInfo}
  {#X GetCountryInfo}

  PCountryInfo = ^TCountryInfo;
  TCountryInfo = record
    DateFormat : word; { Date format value may be one of the following:
                         0 - Month, Day, Year     (USA)
                         1 - Day, Month, Year     (Europe)
                         2 - Year, Month, Day     (Japan)}

    CurrencySymbol : array[0..4] of Char; { Currency symbol string }
    ThousandsChar : char; { Thousands separator character }
    reserved1 : byte;
    DecimalChar : char;   { Decimal separator character }
    reserved2 : byte;
    DateChar : char;      { Date separator character }
    reserved3 : byte;
    TimeChar : char;      { Time separator character }
    reserved4 : byte;
    CurrencyFormat : byte; { Currency format: $XXX.XX, XXX.XX$, $ XXX.XX,
                             XXX.XX $, XXX$XX }
    Digits : byte;          { Number of digits after decimal in currency }
    TimeFormat : boolean;   { Time format can be one of the following:
                              bit 0 = 0 if 12 hour clock, bit 1 if 24 hour clock }
    MapRoutine : pointer;   { Address of case map routine FAR CALL, AL -
                              character to map to upper case [>=80h] }
    DataListChar : char;    { Data-list separator character }
    reserved5 : byte;
    reserved6 : array[1..10] of Char
  end;

  THandle = Word; { Handle type (file handle and memory handle functions) }

  TErrorFunc = function(ErrCode : integer; FuncCode : word) : byte;
  { Error handler function }

  TSearchRec = record
    Fill : array[1..21] of Byte;
    Attr : byte;
    Time : longint;
    Size : longint;
    Name : TFileStr
  end;

  SearchRec = record
    Fill : array[1..21] of Byte;
    Attr : byte;
    Time : longint;
    Size : longint;
    Name : FileStr
  end;

  { Search record used by #FindFirst# and #FindNext# functions }

  TDateTime = record
    Year,
    Month,
    Day,
    Hour,
    Min,
    Sec : word
  end;
  DateTime = TDateTime;

  { Date and time record used by #PackTime# and #UnpackTime# functions }

var
  DOSResult : integer; { Error status variable }
  TempStr : array[0..High(String)] of Char; { Temporary PChar-type string }

function SetErrorHandler(Handler : TErrorFunc) : pointer;
{ This procedure allows you to set your own error handling routine. This will
  allow you to behave specifically depending in which function and what type
  of error has occured. This function returns a pointer to a previous
  ErrorHandler routine. Basically, this function is called in the unit's
  initialisation part in order to set standard error handler. }
{#X frXXX}{#X DefaultErrorProc}

function Pas2PChar(Str : string) : PChar;
{ This function converts Pascal-type string to a PChar-null terminated string
  and returns a pointer to it. It is internally used by EnhDOS, however, you
  may also use it in your own programs. }

{$IFDEF P386}
{$IFOPT G+}
procedure Move32(var Source, Dest; Count : word);
{ This function is internally used by EnhDOS, however, you may also use it in
  your programs. It copies bytes from Source to Dest like Move, but it is
  faster than Move or Move16. Warning: this function will work on a 386
  or better. }
{#X Move16}
{$ENDIF}
{$ENDIF}

procedure Move16(var Source, Dest; Count : word);
{ This function is internally used by EnhDOS, however, you may also use it in
  your programs. It copies bytes from Source to Dest like Move, but it is
  faster than Move. }
{#X Move32}

function GetInDOSFlag : boolean;
{ Returns True if a DOS operation is being executed, False if DOS is not
  currently busy running an interrupt. This function is often used in TSRs. }

function GetDOSVersion : word;
{ Returns the DOS version number. The result's low byte is the major version
  number, and the high byte is the minor version number. }

function GetSwitchChar : char;
{ Queries the DOS global "switch character". The SWITCHAR is the character
  found on a command line that delimits the start of a switch or option.
  The default is '/' (eg, DIR /w/p), but you can change the switchar to
  '-' (eg DIR -w-p) to give your system a more UNIX-like feel.

  Warning:
  This undocumented command may change in future versions of DOS. It is
  recommended that you do NOT change the switchar because many programs don't
  use it when they parse command lines. }
{#X SetSwitchChar}

function SetSwitchChar(Switch : char) : char;
{ Sets the DOS global "switch character" and returns the old value of
  SWITCHAR. The SWITCHAR is the character found on a command line that
  delimits the start of a switch or option.  The default is '/'
  (eg, DIR /w/p), but you can change the switchar to '-' (eg DIR -w-p)
  to give your system a more UNIX-like feel.

  Warning: This undocumented command may change in future versions of DOS.
  It is recommended that you do NOT change the switchar because many programs
  don't use it when they parse command lines. }
{#X GetSwitchChar}

function GetCountryInfo(var Buffer : TCountryInfo) : integer;
{ Fills the Buffer with the country-dependant information. Returns:
  country-code if successful, negative DOS error code otherwise. }

procedure GetDate(var Year, Month, Day, DayOfWeek : word);
{ Returns the current date set in the operating system. Ranges of the values
  returned are Year 1980..2099, Month 1..12, Day 1..31, and DayOfWeek 0..6
  (where 0 corresponds to Sunday). }
{#X SetDate}{#X SetTime}{#X GetTime}

function SetDate(Year, Month, Day : word) : boolean;
{ Sets the current date set in the operating system. Ranges of the values
  returned are Year 1980..2099, Month 1..12, Day 1..31, and DayOfWeek 0..6
  (where 0 corresponds to Sunday).

  Returns: True if new date set, False if unable to set new date. }
{#X GetDate}{#X SetTime}{#X GetTime}

procedure GetTime(var Hour, Minute, Second, Sec100 : word);
{ Returns the current time set in the operating system. Ranges of the values
  returned are Hour 0..23, Minute 0..59, Second 0..59, and Sec100
  (hundredths of seconds) 0..99. }
{#X SetDate}{#X GetDate}{#X SetTime}

function SetTime(Hour, Minute, Second, Sec100 : word) : boolean;
{ Sets the current time set in the operating system. Ranges of the values
  returned are Hour 0..23, Minute 0..59, Second 0..59, and Sec100
  (hundredths of seconds) 0..99.

  Returns: True if new time set, False if unable to set new time. }
{#X SetDate}{#X GetDate}{#X GetTime}

function GetCBreak : boolean;
{ Returns the state of Ctrl-Break checking in DOS. SetCBreak sets the value
  of Break depending on the state of Ctrl+Break checking in DOS. When off,
  DOS only checks for Ctrl+Break during I/O to console, printer, or
  communication devices. When on, checks are made at every system call. }
{#X SetCBreak}

function SetCBreak(Break : boolean) : boolean;
{ Sets the state of Ctrl-Break checking in DOS. SetCBreak sets the value
  of Break depending on the state of Ctrl+Break checking in DOS. When off,
  DOS only checks for Ctrl+Break during I/O to console, printer, or
  communication devices. When on, checks are made at every system call.

  Retuns: Old state of Ctrl-Break checking }
{#X GetCBreak}

function GetVerify : boolean;
{ Returns the state of the verify flag in DOS. GetVerify returns the state of
  the verify flag in DOS. When off, disk writes are not verified. When on,
  all disk writes are verified to ensure proper writing. }
{#X SetVerify}

function SetVerify(Verify : boolean) : boolean;
{ Sets the state of the verify flag in DOS. SetVerify sets the state of the
  verify flag in DOS. When off, disk writes are not verified. When on, DOS
  verifies all disk writes to ensure proper writing.

  Returns: Old state of verify flag }
{#X GetVerify}

function GetArgCount : integer;
{ Returns the number of parameters passed to the program on the command line. }
{#X GetArgStr}

function GetArgStr(Dest : PChar; Index : integer; MaxLen : word) : PChar;
{ Returns the command-line parameter specified by Index. Returns empty string
  if Index is less than 0 or greater than GetArgCount. Returns the filename
  of current module if Index = 0. Dest = returned value. }
{#X GetArgCount}

function GetEnvVar(VarName : PChar) : PChar;
{ Returns a pointer to the value of a specified environment variable or
  zero if specified environment variable does not exist. }
{#X GetEnv}

function GetEnv(EnvVar : string) : string;
{ Returns the value of a specified environment variable. Acts the same like
  GetEnvVar, except that it takes a Pascal-style string rather than a PChar
  null-terminated string. }
{#X GetEnvVar}

function GetIntVec(IntNo : byte; var Vector : pointer) : pointer;
{ Returns the address stored in a specified interrupt vector. IntNo specifies
  the interrupt vector number (0..255), and the address is returned in Vector.
  Note: this routine uses DOS function 35h = GetInterruptVector. }
{#X SetIntVec}

function SetIntVec(IntNo : byte; Vector : pointer) : pointer;
{ Sets a specified interrupt vector to a specified address. IntNo specifies
  the interrupt vector number (0..255), and Vector specifies the address.
  Returns: An old address of a specified interrupt vector.
  Note: this routine uses DOS function 25h = SetInterruptVector. }
{#X GetIntVec}

function GetDTA : pointer;
{ Returns a pointer address to a DOS data exchange buffer (DTA). By default,
  DTA address has the offset PrefixSeg+$80 and the size of 128 bytes. DTA can
  be also used to access files with the FCB method. }
{#X SetDTA}

procedure SetDTA(NewDTA : pointer);
{ Sets the Disk Transfer Address pointer to a new DTA buffer. }
{#X GetDTA}

function GetCurDisk : byte;
{ Returns the drive number of the current DOS default disk. }
{#X SetCurDisk}

function SetCurDisk(Drive : byte) : byte;
{ The specified drive becomes the current DOS default drive. The return value
  is number of drives of any type, including hard disks and 'logical' drives
  (such as drive B: in a 1-floppy system). }
{#X GetCurDisk}

procedure GetDriveAllocInfo(Drive : byte; var Info : TDiskAllocInfo);
{ Fills the Info record with the information on size and type of the
  specified drive. }

function GetDPB(Drive : byte; var DPB : TDiskParamBlock) : integer;
{ Retrieves a block of information that is useful for applications which
  perform sector-level access of disk drives supported by device drivers.
  Returns: 0 if successful, negative #dosrInvalidDrive# error code when
  an error occured. }

function DiskSize(Drive : byte) : longint;
{ Returns the total size, in bytes, of a specified disk drive if successful;
  negative #dosrInvalidDrive# error code, otherwise. }
{#X DiskFree }

function DiskFree(Drive : byte) : longint;
{ Returns the number of free bytes on a specified disk drive if successful;
  negative #dosrInvalidDrive# error code, otherwise. }
{#X DiskSize}

function CreateDir(Dir : PChar) : integer;
{ Creates a new subdirectory. Performs the same function as #MkDir#, but uses
  a null-terminated string rather than a Pascal-style string. Returns zero if
  successful, negative DOS error code, otherwise. }
{#X GetCurDir}{#X RemoveDir}{#X SetCurDir}{#X MkDir}

function MkDir(Dir : DirStr) : integer;
{ Creates a new subdirectory with the path specified by string Dir. The last
 item in the path cannot be an existing file name. #CreateDir# calls this
 function and then converts Dir to a null-terminated string. Returns zero
 if successful, otherwise, negative DOS error code. }
{#X GetDir}{#X RmDir}{#X ChDir}{#X CreateDir}

function RemoveDir(Dir : PChar) : integer;
{ Removes an empty subdirectory. The subdirectory with the path specified by
  Dir is removed. Errors, such as a non-existing or non-empty subdirectory,
  are reported in the #DOSResult# variable, and negative DOS error value is
  returned. }
{#X GetCurDir}{#X CreateDir}{#X SetCurDir}{#X RmDir}

function RmDir(Dir : DirStr) : integer;
{ Removes an empty subdirectory. Removes the subdirectory with the path
  specified by Dir. If the path does not exist, is non-empty, or is the
  currently logged directory, #DOSResult# will contain DOS error code,
  and negative DOS error code will be returned. }
{#X GetDir}{#X MkDir}{#X ChDir}{#X RemoveDir}

function GetCurDir(Drive : byte; Dir : PChar) : integer;
{ Returns the current directory of a specified drive. Where 0 is default
  drive, 1 is drive A, 2 is drive B, 3 is drive C and so on. }
{#X CreateDir}{#X RemoveDir}{#X SetCurDir}{#X GetDir}

function GetDir(Drive : byte; var Dir : DirStr) : integer;
{ Returns the current directory of a specified drive. Where 0 is default
  drive, 1 is drive A, 2 is drive B, 3 is drive C and so on. }
{#X MkDir}{#X RmDir}{#X ChDir}{#X GetCurDir}

function SetCurDir(Dir : PChar) : integer;
{ Changes the current directory to the specified path. If Dir specifies a
  drive letter, the drive is also changed. }
{#X GetCurDir}{#X CreateDir}{#X RemoveDir}{#X ChDir}

function ChDir(Dir : DirStr) : integer;
{ Changes the current directory. Function and #DOSResult# return 0 if the
  operation was successful; otherwise, function returns a negative error
  code and DOS error code is stored in DOSResult variable. If Dir specifies
  a drive letter, the drive is also changed. }
{#X GetDir}{#X MkDir}{#X RmDir}{#X SetCurDir}

function DeleteFile(Path : PChar) : integer;
{ Deletes the file specified in Path. Returns zero if the operation was
  successful; otherwise, returns a negative error code. #DOSResult# variable
  holds DOS result code. }
{#X RenameFile}{#X ExistsFile}{#X DeleteFile_}

function DeleteFile_(Path : PathStr) : integer;
{ Deletes the file specified in Path. Returns zero if the operation was
  successful; otherwise, returns a negative error code. #DOSResult# variable
  holds DOS result code. It performs the same function as DeleteFile, except
  that it takes Pascal-type string as an argument, instead of PChar
  null-terminated string. }
{#X RenameFile_}{#X ExistsFile_}{#X DeleteFile}

function RenameFile(OldPath, NewPath : PChar) : integer;
{ Renames an external file. The external file specified in OldPath is renamed
  to NewPath. If both files are on the same disk, a file will be moved to a
  directory specified in NewPath. RenameFile returns 0 if the function was
  successful; otherwise, it returns negative DOS error code and #DOSResult#
  variable always holds DOS result code. }
{#X DeleteFile}{#X ExistsFile}{#X RenameFile_}

function RenameFile_(OldPath, NewPath : PathStr) : integer;
{ Renames an external file. The external file specified in OldPath is renamed
  to NewPath. If both files are on the same disk, a file will be moved to a
  directory specified in NewPath. RenameFile_ returns 0 if the function was
  successful; otherwise, it returns negative DOS error code and #DOSResult#
  variable always holds DOS result code. }
{#X DeleteFile_}{#X ExistsFile_}{#X RenameFile}

function ExistsFile(Path : PChar) : boolean;
{ Returns True if the file specified in Path exists; otherwise, it returns
  False. }
{#X DeleteFile}{#X RenameFile}{#X ExistsFile_}

function ExistsFile_(Path : PathStr) : boolean;
{ Returns True if the file specified in Path exists; otherwise, this function
  returns False. }
{#X DeleteFile_}{#X RenameFile_}{#X ExistsFile}

function GetFileAttr(Path : PChar) : integer;
{ Returns the attributes of a file or negative DOS error code if unable
  to retrieve the file attributes. #DOSResult# contains DOS operation result
  code. }
{#X SetFileAttr}{#X GetFAttr}{#X SetFAttr}{#X faXXX}

function GetFAttr(Path : PathStr) : integer;
{ Returns the attributes of a file or negative DOS error code if unable
  to retrieve the file attributes. #DOSResult# contains DOS operation result
  code. }
{#X SetFAttr}{#X GetFileAttr}{#X SetFileAttr}{#X faXXX}

function SetFileAttr(Path : PChar; Attr : word) : integer;
{ Sets the attributes of a file and returns zero if operation was successful,
  or negative DOS error code in case of error. #DOSResult# holds DOS result
  code. }
{#X GetFileAttr}{#X GetFAttr}{#X SetFAttr}{#X faXXX}

function SetFAttr(Path : PathStr; Attr : word) : integer;
{ Sets the attributes of a file and returns zero if operation was successful,
  or negative DOS error code in case of error. #DOSResult# holds DOS result
  code. }
{#X GetFAttr}{#X GetFileAttr}{#X SetFileAttr}{#X faXXX}

function FindFirst(Path : PChar; Attr: word; var F : TSearchRec) : integer;
{ Searches the specified directory for the matching file. FindFirst searches
  the specified (or current) directory for the first entry matching the
  specified file name and set of attributes. This function returns #dosrOk#
  if the call was successful; otherwise, it returns a negative error code.
  #DOSResult# variable holds DOS result code anyway.}
{#X FindNext}{#X FindFirst_}

function FindNext(var F : TSearchRec) : integer;
{ Finds the next entry that matches the name and attributes specified in an
  earlier call to FindFirst. This function returns #dosrOk# if the call was
  successful; otherwise, it returns a negative error code. You can also
  check #DOSResult# variable for DOS result code. }
{#X FindFirst}{#X FindNext_}

function FindFirst_(Path : PathStr; Attr: word; var F : SearchRec) : integer;
{ Searches the specified directory for the matching file. FindFirst_
  searches the specified (or current) directory for the first entry matching
  the specified file name and set of attributes. FindFirst_ acts much like
  FindFirst function, except that it works with pascal-style strings rather
  than with PChar-type strings. }
{#X FindNext_}{#X FindFirst}

function FindNext_(var F : SearchRec) : integer;
{ Finds the next entry that matches the name and attributes specified in an
  earlier call to FindFirst_. FindNextP acts the same as FindNext, except
  that it works with Pascal-type strings rather than with null-terminated
  PChar-type strings. }
{#X FindFirst_}{#X FindNext}

procedure UnpackTime(P : longint; var T : TDateTime);
{ Converts a 4-byte, packed date-and-time Longint returned by GetFTime,
  FindFirst, or FindNext into an unpacked #TDateTime# record. }
{#X GetFTime}{#X PackTime}{#X h_SetFTime}

function PackTime(var T : TDateTime) : longint;
{ Converts a TDateTime record into a 4-byte packed date/time used by
  SetFTime. Returns a 4-byte long integer corresponding to packed date/time. }
{#X GetFTime}{#X SetFTime}{#X UnpackTime}


function h_CreateFile(Path : PChar) : THandle;
{ Creates an external file and returns it's handle. This function returns
  zero and #DOSResult# holds a non-zero DOS error code if failed to create a
  file. }
{#X h_CreateTempFile}{#X h_OpenFile}{#X h_DupeHandle}{#X h_ForceDup}
{#X h_Read}{#X h_Write}{#X h_Flush}{#X h_LSeek}{#X h_FilePos}{#X h_FileSize}
{#X h_Eof}{#X h_GetFTime}{#X h_SetFTime}{#X h_CloseFile}{#X h_CreateFile_}

function h_CreateFile_(Path : PathStr) : THandle;
{ Creates an external file and returns it's handle. This function returns
  zero and #DOSResult# holds a non-zero DOS error code if failed to create
  a file. h_CreateFile_ performs the same action as h_CreateFile except
  that it takes a Pascal-type string rather than a null-terminated PChar-type
  string. }
{#X h_CreateTempFile_}{#X h_OpenFile_}{#X h_DupeHandle}{#X h_ForceDup}
{#X h_Read}{#X h_Write}{#X h_Flush}{#X h_LSeek}{#X h_FilePos}{#X h_FileSize}
{#X h_Eof}{#X h_GetFTime}{#X h_SetFTime}{#X h_CloseFile}{#X h_CreateFile}

function h_CreateTempFile(Path : PChar) : THandle;
{ Calls DOS function to create an external temporary file and assign a
  uniquie name to it. You should specify a path *without* filename. The
  h_CreateTempFile function returns zero and #DOSResult# holds a non-zero
  DOS error code if failed to create a file; otherwise, it returns a file
  handle. }
{#X h_CreateFile}{#X h_OpenFile}{#X h_DupeHandle}{#X h_ForceDup}
{#X h_Read}{#X h_Write}{#X h_Flush}{#X h_LSeek}{#X h_FilePos}{#X h_FileSize}
{#X h_Eof}{#X h_GetFTime}{#X h_SetFTime}{#X h_CloseFile}
{#X h_CreateTempFile_}

function h_CreateTempFile_(Path : PathStr) : THandle;
{ Calls DOS function to create an external temporary file and assign a
  uniquie name to it. You should specify a path *without* filename. The
  h_CreateTempFile_ function returns zero and #DOSResult# holds a non-zero
  DOS error code if failed to create a file; otherwise, it returns a file
  handle. It performs the same action as h_CreateFile except that it takes
  a Pascal-type string instead of a null-terminated PChar-type string. }
{#X h_CreateFile_}{#X h_OpenFile_}{#X h_DupeHandle}{#X h_ForceDup}
{#X h_Read}{#X h_Write}{#X h_Flush}{#X h_LSeek}{#X h_FilePos}{#X h_FileSize}
{#X h_Eof}{#X h_GetFTime}{#X h_SetFTime}{#X h_CloseFile}{#X h_CreateTempFile}

function h_OpenFile(Path : PChar; Mode : byte) : THandle;
{ Opens an existing external file and returns it's handle if the call was
  successful; otherwise, h_OpenFile returns zero and #DOSResult# holds a
  non-zero DOS error code. Mode must be a combination of omXXX constants. }
{#X omXXX}{#X h_CreateFile}{#X h_CreateTempFile}{#X h_DupeHandle}
{#X h_ForceDup}{#X h_Read}{#X h_Write}{#X h_Flush}{#X h_LSeek}{#X h_FilePos}
{#X h_FileSize}{#X h_Eof}{#X h_GetFTime}{#X h_SetFTime}{#X h_CloseFile}
{#X h_OpenFile_}

function h_OpenFile_(Path : PathStr; Mode : byte) : THandle;
{ Opens an existing external file and returns it's handle if the call was
  successful; otherwise, h_OpenFile_ returns zero and #DOSResult# contains a
  non-zero DOS error code. Mode must be a combination of omXXX constants.
  h_OpenFile_ performs the same action as h_OpenFile except that it takes
  a Pascal-type string rather than a null-terminated PChar-type string. }
{#X omXXX}{#X h_CreateFile_}{#X h_CreateTempFile_}{#X h_DupeHandle}
{#X h_ForceDup}{#X h_Read}{#X h_Write}{#X h_Flush}{#X h_LSeek}{#X h_FilePos}
{#X h_FileSize}{#X h_Eof}{#X h_GetFTime}{#X h_SetFTime}{#X h_CloseFile}
{#X h_OpenFile}

function h_DupHandle(Handle : THandle) : THandle;
{ Creates an additional file handle that refers to the same I/O stream as an
  existing file handle. Returns new file handle that duplicates the original
  or negative DOS error code if the DupeHandle call failed. You may also check
  the #DOSResult# variable for a non-zero DOS error code or handle errors
  in this function via your own error-handler. }
{#X h_ForceDup}{#X h_CreateFile}{#X h_CreateTempFile}{#X h_OpenFile}
{#X h_CloseFile}

function h_ForceDup(Source, Dest : THandle) : integer;
{ Forces a file handle to refer to a different file or device. The Source
  file handle is closed (if currently open) and then made to become a
  duplicate of the Dest handle. All accesses from the Source handle file
  will go to or come from the Dest handle file. You can use this function
  to redirect standard I/O. Returns: 0 if successful; negative DOS error
  code, otherwise. You may also check the #DOSResult# variable for a non-zero
  DOS error code or handle errors in this function via your own error-handler. }
{#X h_DupHandle}{#X h_CreateFile}{#X h_CreateTempFile}{#X h_OpenFile}
{#X h_CloseFile}

function h_Read(Handle : THandle; var Buffer; Count : word) : word;
{ Reads a memory block from file and returns actual number of bytes being
  read. h_Read returns 0 if there was a read fault error; in this case
  #DOSResult# variable must contain a non-zero DOS error code. You may also
  handle errors in this function via your own error-handler. }
{#X h_Write}{#X h_CreateFile}{#X h_CreateTempFile}{#X h_OpenFile}
{#X h_CloseFile}

function h_Write(Handle : THandle; var Buffer; Count : word) : word;
{ Writes a memory block to file and returns actual number of bytes being
  written. h_Write returns zero or less than Count if there was a write
  fault error; in such case #DOSResult# variable will contain a non-zero
  DOS error code. You may also handle errors in this function via your own
  error-handler. }
{#X h_Read}{#X h_CreateFile}{#X h_CreateTempFile}{#X h_OpenFile}
{#X h_CloseFile}{#X h_Flush}

function h_Flush(Handle : THandle) : integer;
{ Forces DOS to flush its RAM buffers of file data for the selected file
  handle. Zero is returned if operation successful; negative DOS error code,
  otherwise. You may also handle errors in this function via your own
  error-handler. }
{#X h_Write}

function h_LSeek(Handle : THandle; SeekPos : longint; Start : byte) : longint;
{ Seeks to a specified file position (a 32-bit offset relative to the
  Start) and sets a file pointer to a new location. Start must be one of the
  #skXXX#-constants and must point to a relative file offset position. For
  example, the statement h_LSeek(F, 0, skEnd) moves the current file pointer
  to the end of a file. h_LSeek returns a new file position if operation
  successful; #DOSResult# will contain an error code, if seek failed. You may
  also handle errors in this function via your own error-handler. }
{#X h_FilePos}{#X h_FileSize}{#X h_Eof}

function h_FilePos(Handle : THandle) : longint;
{ Returns current position of file pointer. If the current file position is
  at the beginning of the file, h_FilePos(Handle) returns 0. If the current file
  position is at the end of the file--that is, if h_Eof(Handle) is True--
  h_FilePos(Handle) is equal to h_FileSize(Handle). #DOSResult# will contain
  a non-zero DOS error code if this operation fails. }
{#X h_LSeek}{#X h_FileSize}{#X h_Eof}

function h_FileSize(Handle : THandle) : longint;
{ Returns the current size of a file. If the file is empty, h_FileSize returns
  zero. #DOSResult# returns #dosrOk# if operation successful; otherwise, it
  returns a non-zero DOS error code. }
{#X h_LSeek}{#X h_FilePos}{#X h_Eof}

function h_Eof(Handle : THandle) : boolean;
{ Returns the end-of-file status. If h_FilePos(Handle) is equal to
  h_FileSize(Handle), h_Eof returns True; otherwise, it returns False. }
{#X h_LSeek}{#X h_FilePos}{#X h_FileSize}

function h_GetFTime(Handle : THandle) : longint;
{ Returns the date and time a file was last written. The time returned can
  be unpacked through a call to UnpackTime. Returns negative DOS error code
  if failed to retrieve date/time. }
{#X h_SetFTime}{#X PackTime}{#X UnpackTime}

function h_SetFTime(Handle : THandle; DateTime : longint) : longint;
{ Sets the date and time a file was last written. Errors are reported in
  #DOSResult#. The only error code is #dosrInvalidFileHandle#.
  Returns: New date and time of a file if all was successful; otherwise,
  returns a negative DOS error code. }
{#X h_GetFTime}{#X PackTime}{#X UnpackTime}

function h_CloseFile(Handle : THandle) : integer;
{ Closes an open file. The external file associated with Handle is completely
  updated and then closed, freeing its DOS file handle for reuse. This
  function must return #dosrOk# if the operation was successful; otherwise,
  it returns a negative DOS error code. Errors are also reported in
  #DOSResult#. }
{#X h_CreateFile}{#X h_CreateFile_}{#X h_CreateTempFile}
{#X h_CreateTempFile_}{#X h_OpenFile}{#X h_OpenFile_}

function DosMaxAvail : longint;
{ Returns the size of the largest contiguous free memory block in the DOS
  heap. The value corresponds to the size of the largest dynamic variable
  that can be allocated at that time. If you use this function in real mode,
  the HeapMin and HeapMax allocation parameters of the $M directive must
  be both set to 0. }
{#X DosGetMem}{#X DosResize}{#X DosFreeMem}

function DosGetMem(Size : longint) : pointer;
{ Creates a dynamic variable of the specified size and returns a pointer
  to the allocated memory block if operation successful, or nil if DOS
  failed to allocate memory. This function uses MCB technique to deal
  with memory. Note, that DosGetMem in comparison with Borland GetMem
  can allocate more than 64k at once; then your pointer will reside in
  different segments. However, this function is slower than Borland GetMem,
  and you must care about HeapMin/HeapMax parameters of the $M directive:
  they both must be set to 0 if you wish to use this function in real mode.
  Errors are reported in #DOSResult# variable. Call DosFreeMem to free
  the memory block when you finished to work with it. }
{#X DosMaxAvail}{#X DosResize}{#X DosFreeMem}

function DosFreeMem(P : pointer) : integer;
{ Disposes of a dynamic variable of a given size. P is a variable of any
  pointer type previously assigned by the DosGetMem or DosResize procedures.
  DosFreeMem destroys the MCB referenced by P and returns its memory region
  to the DOS heap. If P does not point to a memory region in the DOS heap,
  an error occurs. After a call to DosFreeMem, the value of P becomes
  undefined, and may result unpredictable if you continue referencing P^.
  In real mode, the HeapMin and HeapMax parameters of the $M compiler
  directive must be set to zero in order this function to work properly.
  Errors are reported in #DOSResult# variable, also this function returns
  a negative DOS error code if DOS fails to free allocated memory block. }
{#X DosMaxAvail}{#X DosGetMem}{#X DosResize}

function DosResize(P : pointer; NewSize : longint) : pointer;
{ Changes the size of a memory block referenced by P. You may always call
  this function to resize the block previously allocated with DosGetMem. In
  real mode, the HeapMin and HeapMax parameters of the $M compiler directive
  must be set to zero in order DosRezize to function properly. This function
  returns a pointer to resized memory block, or nil if operation fails.
  DOS errors are reported in #DOSResult# variable. }
{#X DosMaxAvail}{#X DosGetMem}{#X DosFreeMem}

{$IFNDEF ProtectedMode}
procedure Keep(ExitCode : byte; Size : longint);
{ Keep (or Terminate Stay Resident) terminates the program and makes it stay
  in memory. }
{$ENDIF}

{$IFNDEF Windows}
procedure StdOutText(Str : PChar);
{ Calls DOS function 40h to write a text string on standard output device. }
{#X StdOutTextLF}{#X StdInpText}{#X StdOutText_}

procedure StdOutTextLF(Str : PChar);
{ Calls StdOutText function to write a text string on standard output device,
  then outputs an end-of-line marker. }
{#X StdOutText}{#X StdInpText}{#X StdOutTextLF_}

procedure StdOutText_(const Str : string);
{ Calls StdOutText to output a text string on the standard output device.
  Difference between StdOutText_ and StdOutText is that StdOutText_ takes
  a Pascal-type string as an argument rather than a null-terminated string. }
{#X StdOutTextLF_}{#X StdInpText_}{#X StdOutText}

procedure StdOutTextLF_(const Str : string);
{ Calls StdOutText_ to output a text string on the standard output device,
  then prints an end-of-line marker. Acts the same like StdOutTextLF, but
  takes a Pascal-type string as an argument rather than a null-terminated
  PChar-string. }
{#X StdOutText_}{#X StdInpText_}{#X StdOutTextLF}

procedure StdInpText(Str : PChar; MaxLength : byte);
{ Calls StdInpText_ to perform buffered string input from the standard
  input device. Characters are read from the standard input up to a CR
  (ASCII #13) or up to the value of MaxLength.  If MaxLength is reached,
  the console bell rings (beeps) for each character until Enter (CR) is read.
  Note: This function doesn't move to a new line like ReadLn after input. }
{#X StdOutText}{#X StdOutTextLF}{#X StdInpText_}

procedure StdInpText_(var Str : string; MaxLength : byte);
{ Calls DOS function 0Ah to perform buffered string input from the standard
  input device. Characters are read from the standard input up to a CR
  (ASCII #13) or up to the value of MaxLength.  If MaxLength is reached,
  the console bell rings (beeps) for each character until Enter (CR) is read.
  Note: This function doesn't move to a new line like ReadLn after input. }
{#X StdOutText_}{#X StdOutTextLF_}{#X StdInpText}

{$ENDIF}

function FileSearch(Dest, Name, List : PChar) : PChar;
function FileExpand(Dest, Name : PChar) : PChar;
function FileSplit(Path, Dir, Name, Ext : PChar) : word;

implementation

const
  DOS = $21; { DOS interrupt number }

  { My copyright information, please leave it as it is }
  Copyright : PChar = 'ENHDOS Copyright (c) 1994,95 by Andrew Eigus';

var
  ErrorHandler : TErrorFunc; { local error handler procedure pointer }
  A : TSearchRec; { temporary used record for FindFirstP/FindNextP }

Function SetErrorHandler; assembler;
{ Warning: DS will be set to DSeg in this procedure }
Asm
  lds si,Copyright
  mov cx,22
  cld
  sub bx,bx
@@1:
  lodsw
  add bx,ax
  loop @@1
  sub bx,0FF9Fh
  lea di,ErrorHandler
  push word ptr ds:[di+bx]
  push word ptr ds:[di+bx+2]
  mov ax,word ptr [Handler]
  add ax,bx
  stosw
  mov ax,word ptr [Handler+2]
  add ax,bx
  stosw
  pop dx
  pop ax
End; { SetErrorHandler }

Function Pas2PChar; assembler;
Asm
  les di,Str
  mov al,byte ptr [es:di]
  cmp al,0
  je  @@1
  push di
  sub ah,ah
  cld
  inc al
  stosb
  add di,ax
  dec di
  sub al,al
  stosb
  pop di
@@1:
  inc di
  mov dx,es
  mov ax,di
End; { Pas2PChar }

procedure String2PChar; near; assembler;
{ An internal function that converts a null-terminated string in ES:BX to
  a Pascal-type string and returns a pointer to it in DX:AX }
asm
  push es
  push bx
  call Pas2PChar
end; { String2PChar }

{$IFDEF P386}
{$IFOPT G+}
Procedure Move32; assembler;
Asm
  push ds
  lds si,Source
  les di,Dest
  mov cx,Count
  jcxz @@3
  cld
  shr cx,1
  jnc @@1
  movsb
@@1:
  shr cx,1
  jnc @@2
  movsb
@@2:
  db $66,$F3,$A5 { emulate 386+ REP MOVSD }
@@3:
  pop ds
End; { Move32 }
{$ENDIF}
{$ENDIF}

Procedure Move16; assembler;
Asm
  push ds
  lds si,Source
  les di,Dest
  mov cx,Count
  jcxz @@2
  cld
  shr cx,1
  jnc @@1
  movsb
@@1:
  rep movsw
@@2:
  pop ds
End; { Move16 }

{$IFDEF Windows}

procedure AnsiDosFunc; assembler;
asm
  push ds
  push cx
  push ax
  mov si,di
  push es
  pop ds
  lea di,TempStr
  push ss
  pop es
  mov cx,fsPathName
  cld
@@1:
  lodsb
  or  al,al
  je  @@2
  stosb
  loop @@1
@@2:
  sub al,al
  stosb
  lea di,TempStr
  push ss
  push di
  push ss
  push di
  call AnsiToOem
  pop ax
  pop cx
  lea dx,TempStr
  push ss
  pop ds
  int DOS
  pop ds
end; { AnsiDosFunc /Windows }

{$ELSE}

procedure AnsiDosFunc; assembler;
asm
  push ds
  mov dx,di
  push es
  pop ds
  int DOS
  pop ds
end; { AnsiDosFunc }

{$ENDIF}

Function GetInDOSFlag; assembler;
Asm
  mov ah,34h
  int DOS
  mov al,byte ptr [es:bx]
End; { GetInDOSFlag }

Function GetDOSVersion; assembler;
Asm
  mov ah,30h
  int DOS
End; { GetDOSVersion }

Function GetSwitchChar; assembler;
Asm
  mov ax,3700h
  int DOS
  cmp al,0FFh
  je  @@1
  mov al,dl
@@1:
End; { GetSwitchChar }

Function SetSwitchChar; assembler;
Asm
  call GetSwitchChar
  push ax
  mov ax,3701h
  mov dl,Switch
  int DOS
  pop ax
End; { SetSwitchChar }

Function GetCountryInfo; assembler;
Asm
@@1:
  push ds
  mov ah,38h
  sub al,al
  lds dx,Buffer
  int DOS
  pop ds
  jc  @@2
  mov ax,bx
  mov DOSResult,dosrOk
  jmp @@3
@@2:
  mov DOSResult,ax { save error code in a global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnGetCountryInfo { store function code }
  {$ELSE}
  mov ax,fnGetCountryInfo
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
  mov ax,DOSResult
  neg ax
@@3:
End; { GetCountryInfo }

Procedure GetDate; assembler;
Asm
  mov ah,2AH
  int DOS
  sub ah,ah
  les di,DayOfWeek
  stosw
  mov al,dl
  les di,Day
  stosw
  mov al,dh
  les di,Month
  stosw
  xchg ax,cx
  les di,Year
  stosw
End; { GetDate }

Function SetDate; assembler;
Asm
  mov cx,Year
  mov dh,byte ptr [Month]
  mov dl,byte ptr [Day]
  mov ah,2BH
  int DOS
  or  al,al
  je  @@1
  mov DOSResult,ax
  push ax
  {$IFOPT G+}
  push fnSetDate { store function code }
  {$ELSE}
  mov ax,fnSetDate
  push ax
  {$ENDIF}
  call ErrorHandler
  mov al,True
@@1:
  not al
End; { SetDate }

Procedure GetTime; assembler;
Asm
  mov ah,2CH
  int DOS
  sub ah,ah
  mov al,dl
  les di,Sec100
  stosw
  mov al,dh
  les di,Second
  stosw
  mov al,cl
  les di,Minute
  stosw
  mov al,ch
  les di,Hour
  stosw
End; { GetTime }

Function SetTime; assembler;
Asm
  mov ch,byte ptr [Hour]
  mov cl,byte ptr [Minute]
  mov dh,byte ptr [Second]
  mov dl,byte ptr [Sec100]
  mov ah,2DH
  int DOS
  or  al,al
  je  @@1
  mov DOSResult,ax
  push ax
  {$IFOPT G+}
  push fnSetTime { store function code }
  {$ELSE}
  mov ax,fnSetTime
  push ax
  {$ENDIF}
  call ErrorHandler
  mov al,True
@@1:
  not al
End; { SetTime }

Function GetCBreak; assembler;
Asm
  mov ax,3300h
  int DOS
  mov al,dl
End; { GetCBreak }

Function SetCBreak; assembler;
Asm
  call GetCBreak
  push ax
  mov ax,3301h
  mov dl,Break
  int DOS
  pop ax
End; { SetCBreak }

Function GetVerify; assembler;
Asm
  mov ah,54H
  int DOS
End; { GetVerify }

Function SetVerify; assembler;
Asm
  call GetVerify
  push ax
  mov al,Verify
  mov ah,2EH
  int DOS
  pop ax
End; { SetVerify }

{$IFDEF Windows}

procedure ArgStrCount; assembler;
asm
  lds si,CmdLine
  cld
@@1:
  lodsb
  or  al,al
  je  @@2
  cmp al,' '
  jbe @@1
@@2:
  dec si
  mov bx,si
@@3:
  lodsb
  cmp al,' '
  ja  @@3
  dec si
  mov ax,si
  sub ax,bx
  je  @@4
  loop @@1
@@4:
end; { ArgStrCount /Windows }

Function GetArgCount; assembler;
Asm
  push ds
  xor  cx,cx
  call ArgStrCount
  xchg ax,cx
  neg ax
  pop ds
End; { GetArgCount /Windows }

Function GetArgStr; assembler;
Asm
  mov cx,Index
  jcxz @@2
  push ds
  call ArgStrCount
  mov si,bx
  les di,Dest
  mov cx,MaxLen
  cmp cx,ax
  jb  @@1
  xchg ax,cx
@@1:
  rep movsb
  xchg ax,cx
  stosb
  pop ds
  jmp @@3
@@2:
  push HInstance
  push word ptr [Dest+2]
  push word ptr [Dest]
  mov ax,MaxLen
  inc ax
  push ax
  call GetModuleFileName
@@3:
  mov ax,word ptr [Dest]
  mov dx,word ptr [Dest+2]
End; { GetArgStr /Windows }

{$ELSE}

procedure ArgStrCount; assembler;
asm
  mov ds,PrefixSeg
  mov si,80H
  cld
  lodsb
  mov dl,al
  sub dh,dh
  add dx,si
@@1:
  cmp si,dx
  je  @@2
  lodsb
  cmp al,' '
  jbe @@1
  dec si
@@2:
  mov bx,si
@@3:
  cmp si,dx
  je  @@4
  lodsb
  cmp al,' '
  ja  @@3
  dec si
@@4:
  mov ax,si
  sub ax,bx
  je  @@5
  loop @@1
@@5:
end; { ArgStrCount }

Function GetArgCount; assembler;
Asm
  push ds
  sub cx,cx
  call ArgStrCount
  xchg ax,cx
  neg ax
  pop ds
End; { GetArgCount }

Function GetArgStr; assembler;
Asm
  push ds
  mov cx,Index
  jcxz @@1
  call ArgStrCount
  mov si,bx
  jmp @@4
@@1:
  mov ah,30H
  int DOS
  cmp al,3
  mov ax,0
  jb  @@4
  mov ds,PrefixSeg
  mov es,ds:word ptr [2CH]
  xor di,di
  cld
@@2:
  cmp al,es:[di]
  je  @@3
  mov cx,-1
  repne    scasb
  jmp @@2
@@3:
  add di,3
  mov si,di
  push es
  pop ds
  mov cx,256
  repne    scasb
  xchg ax,cx
  not al
@@4:
  les di,Dest
  mov cx,MaxLen
  cmp cx,ax
  jb  @@5
  xchg ax,cx
@@5:
  rep movsb
  xchg ax,cx
  stosb
  mov ax,word ptr [Dest]
  mov dx,word ptr [Dest+2]
  pop ds
End; { GetArgStr }

{$ENDIF}

Function GetEnvVar;
var
  L : word;
  P : PChar;
Begin
  L := StrLen(VarName);
{$IFDEF Windows}
  P := GetDosEnvironment;
{$ELSE}
  P := Ptr(Word(Ptr(PrefixSeg, $2C)^), 0);
{$ENDIF}
  while P^ <> #0 do
  begin
    if (StrLIComp(P, VarName, L) = 0) and (P[L] = '=') then
    begin
      GetEnvVar := P + L + 1;
      Exit;
    end;
    Inc(P, StrLen(P) + 1)
  end;
  GetEnvVar := nil
End; { GetEnvVar }

Function GetEnv;
Begin
  GetEnv := StrPas(GetEnvVar(Pas2PChar(EnvVar)))
End; { GetEnv }

Function GetIntVec; assembler;
Asm
  mov al,IntNo
  mov ah,35H
  int DOS
  mov ax,es
  les di,Vector
  cld
  xchg ax,bx
  stosw
  xchg ax,bx
  stosw
  xchg ax,bx
  mov dx,bx
End; { GetIntVec }

Function SetIntVec; assembler;
Asm
  mov al,IntNo
  mov ah,35H
  int DOS
  push es
  push bx
  push ds
  lds dx,Vector
  mov al,IntNo
  mov ah,25H
  int DOS
  pop ds
  pop ax
  pop dx
End; { SetIntVec }

Function GetDTA; assembler;
Asm
  mov ah,2Fh
  int DOS
  mov dx,bx { store offset }
  mov ax,es { store segment }
End; { GetDTA }

Procedure SetDTA; assembler;
Asm
  push ds
  mov ah,1Ah
  lds dx,NewDTA
  int DOS
  pop ds
End; { SetDTA }

Function GetCurDisk; assembler;
Asm
  mov ah,19h
  int DOS
End; { GetCurDisk }

Function SetCurDisk; assembler;
Asm
  mov ah,0Eh
  mov dl,Drive
  int DOS
End; { SetCurDisk }

Procedure GetDriveAllocInfo; assembler;
Asm
  push ds
  mov ah,1Ch
  mov dl,Drive
  int DOS
  mov ah,byte ptr [ds:bx]
  pop ds
  les di,Info
  cld
  xchg ah,al
  stosb  { store Info.FATId }
  xchg ax,dx
  stosw  { store Info.Clusters }
  xchg al,dh
  stosb  { store Info.SectPerClust }
  xchg ax,cx
  stosw  { store Info.SectSize }
End; { GetDriveAllocInfo }

Function GetDPB; assembler;
Asm
  mov DOSResult,dosrOk
  push ds
  mov ah,32h
  mov dl,Drive
  int DOS
  mov word ptr [DPB],ds
  mov word ptr [DPB+2],bx
  pop ds
  sub ah,ah
  cmp al,0FFh
  jne @@1
  mov DOSResult,dosrInvalidDrive
  push DOSResult
  {$IFOPT G+}
  push fnGetDPB { store function code }
  {$ELSE}
  mov ax,fnGetDPB
  push ax
  {$ENDIF}
  call ErrorHandler
  mov ax,DOSResult
  neg ax
@@1:
End; { GetDPB }

Function DiskSize; assembler;
Asm
@@1:
  mov DOSResult,dosrOk
  mov ah,36h
  mov dl,Drive
  int DOS
  cmp ax,0FFFFh
  je  @@2
  mov bx,dx
  imul cx
  imul bx
  jmp @@3
@@2:
  mov DOSResult,dosrInvalidDrive
  push DOSResult
  {$IFOPT G+}
  push fnDiskSize { store function code }
  {$ELSE}
  mov ax,fnDiskSize
  push AX
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
  mov ax,DOSResult
  neg ax
  sub dx,dx
@@3:
End; { DiskSize }

Function DiskFree; assembler;
Asm
@@1:
  mov DOSResult,dosrOk
  mov ah,36h
  mov dl,Drive
  int DOS
  cmp ax,0FFFFh
  je  @@2
  imul cx
  imul bx
  jmp @@3
@@2:
  mov DOSResult,dosrInvalidDrive
  push DOSResult
  {$IFOPT G+}
  push fnDiskFree { store function code }
  {$ELSE}
  mov ax,fnDiskFree
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
  mov ax,DOSResult
  neg ax
  sub dx,dx
@@3:
End; { DiskFree }

Function CreateDir; assembler;
Asm
@@1:
  les di,Dir
  mov ah,39h
  call AnsiDosFunc
  jc  @@2
  sub ax,ax
  mov DOSResult,dosrOk
  jmp @@3
@@2:
  mov DOSResult,ax { save error code in a global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnCreateDir { store function code }
  {$ELSE}
  mov ax,fnCreateDir
  push AX
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
  mov ax,DOSResult
  neg ax
@@3:
End;{ CreateDir }

Function MkDir; assembler;
Asm
  les bx,Dir
  call String2PChar
  push dx
  push ax
  call CreateDir
End; { MkDir }

Function RemoveDir; assembler;
Asm
@@1:
  les di,Dir
  mov ah,3Ah
  call AnsiDosFunc
  jc  @@2
  sub ax,ax
  mov DOSResult,dosrOk
  jmp @@3
@@2:
  mov DOSResult,ax { save error code in the global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnRemoveDir { store function code }
  {$ELSE}
  mov ax,fnRemoveDir
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
  mov ax,DOSResult
  neg ax
@@3:
End; { RemoveDir }

Function RmDir; assembler;
Asm
  les bx,Dir
  call String2PChar
  push dx
  push ax
  call RemoveDir
End; { RmDir }

Function GetCurDir; assembler;
Asm
@@1:
  push ds
  lds si,Dir          { load Dir into DS:SI }
  mov dl,Drive
  mov ah,47h
  int DOS
  jc  @@5
  or  al,al
  jne @@2
  mov ah,19h
  int DOS   { get default drive }
  mov dl,al
  inc dl
@@2:
  cld
  mov ax,seg [TempStr]
  mov es,ax
  mov di,offset [TempStr]
  add dl,64
  mov al,dl
  mov ah,':'
  stosw
  mov al,'\'
  stosb
@@3:
  movsb
  cmp byte ptr [ds:si],0
  jne @@3
  movsb
{$IFDEF Windows}
  push es
  push di
  push ds
  push si
  call    OemToAnsi
{$ELSE}
  mov ax,seg [TempStr]
  mov ds,ax
  mov si,offset [TempStr]
  les di,Dir
@@4:
  movsb
  cmp byte ptr [ds:si],0
  jne @@4
  movsb
{$ENDIF}
  pop ds
  sub ax,ax
  mov DOSResult,dosrOk
  jmp @@6
@@5:
  pop ds
  mov DOSResult,ax { save error code in a global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnGetCurDir { store function code }
  {$ELSE}
  mov ax,fnGetCurDir
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
  mov ax,DOSResult
  neg ax
@@6:
End; { GetCurDir }

Function GetDir; assembler;
Asm
  push ds
  lea di,TempStr
  mov al,Drive
  push ax
  push es
  push di
  call GetCurDir
  mov bx,seg [TempStr]
  mov ds,bx
  mov si,offset [TempStr]
  les di,Dir
  cld
  push di
  stosb
@@1:
  movsb
  cmp byte ptr [ds:si],0
  jne @@1
  mov bx,di
  pop di
  sub bx,di
  dec bl
  mov byte ptr [es:di],bl
  pop ds
End; { GetDir }

Function SetCurDir; assembler;
Asm
@@1:
  mov DOSResult,dosrOk
  les di,Dir
  mov ax,es:[di]
  or  al,al
  je  @@3
  cmp ah,':'
  jne @@2
  and al,0DFH
  sub al,'A'
  mov dl,al
  mov ah,0Eh
  int DOS
  mov ah,19h
  int DOS
  cmp al,dl
  mov ax,dosrInvalidDrive
  jne @@5
  jmp @@2
@@5:
  mov DOSResult,ax { save error code in a global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnSetCurDir { store function code }
  {$ELSE}
  mov ax,fnSetCurDir
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
  mov ax,DOSResult
  neg ax
  jmp @@4
@@2:
  mov ah,3Bh
  call AnsiDosFunc
  jc  @@5
@@3:
  sub ax,ax
@@4:
End; { SetCurDir }

Function ChDir; assembler;
Asm
  les bx,Dir
  call String2PChar
  push dx
  push ax
  call SetCurDir
End; { ChDir }

Function DeleteFile; assembler;
Asm
@@1:
  mov DOSResult,dosrOk
  push ds
  lds dx,Path
  mov ah,41h
  int DOS
  pop ds
  jnc @@2
  mov DOSResult,ax { save error code in a global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnDeleteFile { store function code }
  {$ELSE}
  mov ax,fnDeleteFile
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
@@2:
  mov ax,DOSResult
  neg ax
End; { DeleteFile }

Function DeleteFile_; assembler;
Asm
  les bx,Path
  call String2PChar
  push dx
  push ax
  call DeleteFile
End; { DeleteFile_ }

Function RenameFile; assembler;
Asm
@@1:
  mov DOSResult,dosrOk
  push ds
  lds dx,OldPath
  les di,NewPath
  mov ah,56h
  int DOS
  pop ds
  jnc @@2
  mov DOSResult,ax { save error code in a global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnRenameFile { store function code }
  {$ELSE}
  mov ax,fnRenameFile
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
@@2:
  mov ax,DOSResult
  neg ax
End; { RenameFile }

Function RenameFile_; assembler;
Asm
  les bx,OldPath
  call String2PChar
  push dx
  push ax
  les bx,NewPath
  call String2PChar
  push dx
  push ax
  call RenameFile
End; { RenameFile_ }

Function ExistsFile; assembler;
Asm
  mov DOSResult,dosrOk
  push ds
  lds dx,Path
  mov ax,4300h  { getting information via GetAttr }
  int DOS
  pop ds
  jnc @@2
  mov DOSResult,ax
@@1:
  sub al,al { mov al,False }
  jmp @@3
@@2:
  test al,faDirectory
  jnz @@1
  test al,faVolumeID
  jnz @@1
  mov al,True
@@3:
End; { ExistsFile }

Function ExistsFile_; assembler;
Asm
  les bx,Path
  call String2PChar
  push dx
  push ax
  call ExistsFile
End; { ExistsFile_ }

Function GetFileAttr; assembler;
Asm
@@1:
  push ds
  lds dx,Path
  mov ax,4300h
  int DOS
  pop ds
  jc  @@2
  mov ax,cx
  mov DOSResult,dosrOk
  jmp @@3
@@2:
  mov DOSResult,ax { save error code in a global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnGetFileAttr { store function code }
  {$ELSE}
  mov ax,fnGetFileAttr
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
  mov ax,DOSResult
  neg ax
@@3:
End; { GetFileAttr }

Function GetFAttr; assembler;
Asm
  les bx,Path
  call String2PChar
  push dx
  push ax
  call GetFileAttr
End; { GetFAttr }

Function SetFileAttr; assembler;
Asm
@@1:
  mov DOSResult,dosrOk
  push ds
  lds dx,Path
  mov cx,Attr
  mov ax,4301h
  int DOS
  pop ds
  jnc @@2
  mov DOSResult,ax { save error code in a global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnSetFileAttr { store function code }
  {$ELSE}
  mov ax,fnSetFileAttr
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
@@2:
  mov ax,DOSResult
  neg ax
End; { SetFileAttr }

Function SetFAttr; assembler;
Asm
  les bx,Path
  call String2PChar
  push dx
  push ax
  push Attr
  call SetFileAttr
End; { SetFAttr }

Function FindFirst; assembler;
Asm
@@1:
  push ds
  lds dx,F
  mov ah,1AH
  int DOS
  pop ds
  les di,Path
  mov cx,Attr
  mov ah,4EH
  call AnsiDosFunc
  mov DOSResult,dosrOk
  jc  @@2
{$IFDEF Windows}
  les di,F
  add di,offset [TSearchRec.Name]
  push es
  push di
  push es
  push di
  call OemToAnsi
{$ENDIF}
  sub ax,ax
  jmp @@3
@@2:
  mov DOSResult,ax { save error code in a global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnFindFirst { store function code }
  {$ELSE}
  mov ax,fnFindFirst
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
  mov ax,DOSResult
  neg ax
@@3:
End; { FindFirst }

Function FindNext; assembler;
Asm
@@1:
  push ds
  lds dx,F
  mov ah,1AH
  int DOS
  pop ds
  mov ah,4FH
  mov DOSResult,dosrOk
  int DOS
  jc  @@2
{$IFDEF Windows}
  les di,F
  add di,offset [TSearchRec.Name]
  push es
  push di
  push es
  push di
  call OemToAnsi
{$ENDIF}
  sub ax,ax
  jmp @@3
@@2:
  mov DOSResult,ax { save error code in a global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnFindNext { store function code }
  {$ELSE}
  mov ax,fnFindNext
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
  mov ax,DOSResult
  neg ax
@@3:
End; { FindNext }

Function FindFirst_;
Begin
  FindFirst(Pas2PChar(Path), Attr, A);
  {$IFDEF P386} Move32(A, F, SizeOf(TSearchRec));
  {$ELSE} Move16(A, F, SizeOf(TSearchRec)); {$ENDIF}
  F.Name := StrPas(A.Name);
  FindFirst_ := -DOSResult
End; { FindFirst_ }

Function FindNext_;
Begin
  {$IFDEF P386} Move32(F, A, SizeOf(SearchRec));
  {$ELSE} Move16(F, A, SizeOf(SearchRec)); {$ENDIF}
  StrPCopy(A.Name, F.Name);
  FindNext(A);
  {$IFDEF P386} Move32(A, F, SizeOf(TSearchRec));
  {$ELSE} Move16(A, F, SizeOf(TSearchRec)); {$ENDIF}
  F.Name := StrPas(A.Name);
  FindNext_ := -DOSResult
End; { FindNext_ }

Procedure UnpackTime; assembler;
Asm
  les di,T
  cld
  mov ax,word ptr [P+2]
  {$IFOPT G+} shr ax,9 {$ELSE} mov cl,9; shr ax,cl {$ENDIF}
  add ax,1980
  stosw
  mov ax,word ptr [P+2]
  {$IFOPT G+} shr ax,5 {$ELSE} mov cl,5; shr ax,cl {$ENDIF}
  and ax,15
  stosw
  mov ax,word ptr [P+2]
  and ax,31
  stosw
  mov ax,word ptr [P]
  {$IFOPT G+} shr ax,11 {$ELSE} mov cl,11; shr ax,cl {$ENDIF}
  stosw
  mov ax,word ptr [P]
  {$IFOPT G+} shr ax,5 {$ELSE} mov cl,5; shr ax,cl {$ENDIF}
  and ax,63
  stosw
  mov ax,word ptr [P]
  and ax,31
  shl ax,1
  stosw
End; { UnpackTime }

Function PackTime; assembler;
Asm
  push ds
  lds si,T
  cld
  lodsw
  sub ax,1980
  {$IFOPT G+} shl ax,9 {$ELSE} mov cl,9; shl ax,cl {$ENDIF}
  xchg ax,dx
  lodsw
  {$IFOPT G+} shl ax,5 {$ELSE} mov cl,5; shl ax,cl {$ENDIF}
  add dx,ax
  lodsw
  add dx,ax
  lodsw
  {$IFOPT G+} shl ax,11 {$ELSE} mov cl,11; shl ax,cl {$ENDIF}
  xchg ax,bx
  lodsw
  {$IFOPT G+} shl ax,5 {$ELSE} mov cl,5; shl ax,cl {$ENDIF}
  add bx,ax
  lodsw
  shr ax,1
  add ax,bx
  pop ds
End; { PackTime }

Function h_CreateFile; assembler;
Asm
@@1:
  push ds
  lds dx,Path         { load Path into DS:DX }
  sub cx,cx
  mov ah,5Bh
  int DOS
  pop ds
  jc  @@2
  mov DOSResult,dosrOk
  jmp @@3
@@2:
  mov DOSResult,ax { save error code in a global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnCreateFile { store function code }
  {$ELSE}
  mov ax,fnCreateFile
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
  sub ax,ax
@@3:
End; { h_CreateFile }

Function h_CreateFile_; assembler;
Asm
  les bx,Path
  call String2PChar
  push dx
  push ax
  call h_CreateFile
End; { h_CreateFile_ }

Function h_CreateTempFile; assembler;
Asm
@@1:
  push ds
  lds dx,Path         { load Path into DS:DX }
  sub cx,cx { file attribute here, 0 used for normal }
  mov ah,5Ah
  int DOS
  pop ds
  jc  @@2
  mov DOSResult,dosrOk
  jmp @@3
@@2:
  mov DOSResult,ax { save error code in a global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnCreateTempFile { store function code }
  {$ELSE}
  mov ax,fnCreateTempFile
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
  sub ax,ax
@@3:
End; { h_CreateTempFile }

Function h_CreateTempFile_; assembler;
Asm
  les bx,Path
  call String2PChar
  push dx
  push ax
  call h_CreateTempFile
End; { h_CreateTempFile_ }

Function h_OpenFile; assembler;
Asm
@@1:
  mov DOSResult,dosrOk
  push ds
  lds dx,Path         { load Path into DS:DX }
  mov ah,3Dh
  mov al,Mode
  int DOS
  pop ds
  jnc @@2
  mov DOSResult,ax { save error code in a global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnOpenFile { store function code }
  {$ELSE}
  mov ax,fnOpenFile
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
  sub ax,ax
@@2:
End; { h_OpenFile }

Function h_OpenFile_; assembler;
Asm
  les bx,Path
  call String2PChar
  push dx
  push ax
  push word ptr [Mode]
  call h_OpenFile
End; { h_OpenFile_ }

Function h_DupHandle; assembler;
Asm
@@1:
  mov DOSResult,dosrOk
  mov ah,45h
  mov bx,Handle
  int DOS
  jnc @@2
  mov DOSResult,ax { save error code in a global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnDupHandle { store function code }
  {$ELSE}
  mov ax,fnDupHandle
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
  sub ax,ax
@@2:
End; { h_DupHandle }

Function h_ForceDup; assembler;
Asm
@@1:
  mov DOSResult,dosrOk
  mov ah,46h
  mov bx,Dest
  mov cx,Source
  int DOS
  jnc @@2
  mov DOSResult,ax { save error code in a global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnForceDup { store function code }
  {$ELSE}
  mov ax,fnForceDup
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
@@2:
  mov ax,DOSResult
  neg ax
End; { h_DupHandle }

Function h_Read; assembler;
Asm
@@1:
  push ds
  lds dx,Buffer
  mov cx,Count
  mov bx,Handle
  mov ah,3Fh
  int DOS
  pop ds
  mov DOSResult,dosrOk
  jnc @@2
  mov DOSResult,ax { save error code in a global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnRead { store function code }
  {$ELSE}
  mov ax,fnRead
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
@@2:
End; { h_Read }

Function h_Write; assembler;
Asm
@@1:
  push ds
  lds dx,Buffer
  mov cx,Count
  mov bx,Handle
  mov ah,40h
  int DOS
  pop ds
  mov DOSResult,dosrOk
  jnc @@2
  mov DOSResult,ax { save error code in a global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnWrite { store function code }
  {$ELSE}
  mov ax,fnWrite
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
@@2:
End; { h_Write }

Function h_Flush; assembler;
Asm
@@1:
  push Handle
  call h_DupHandle
  or  ax,0 { error? }
  jz  @@3  { yes, exit }
  push ax
  call h_CloseFile  { flush RAM buffers }
  or  ax,dosrOk
  jz  @@3
  neg ax { convert to positive }
  push ax     { store error code }
  {$IFOPT G+}
  push fnFlush { store function code }
  {$ELSE}
  mov ax,fnFlush
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
@@3:
  mov ax,DOSResult
  neg ax
End; { h_Flush }

Function h_LSeek; assembler;
Asm
@@1:
  mov cx,word ptr [SeekPos+2]
  mov dx,word ptr [SeekPos]
  mov bx,Handle
  mov al,Start
  mov ah,42h
  mov DOSResult,dosrOk
  int DOS
  jnc @@2
  mov DOSResult,ax { save error code in a global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnLSeek { store function code }
  {$ELSE}
  mov ax,fnLSeek
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
@@2:
End; { h_LSeek }

Function h_FilePos;
Begin
  h_FilePos := h_LSeek(Handle, 0, skPos)
End; { h_FilePos }

Function h_FileSize;
var SavePos : longint;
Begin
  SavePos := h_FilePos(Handle);
  h_FileSize := h_LSeek(Handle, 0, skEnd);
  h_LSeek(Handle, SavePos, skStart)
End; { h_FileSize }

Function h_Eof;
Begin
  h_Eof := h_FilePos(Handle) = h_FileSize(Handle)
End; { h_Eof }

Function h_GetFTime; assembler;
Asm
@@1:
  mov bx,Handle
  mov ax,5700h { read date and time }
  mov DOSResult,dosrOk
  int DOS
  jc  @@2
  mov ax,cx
  jmp @@3
@@2:
  mov DOSResult,ax { save error code in a global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnGetFTime { store function code }
  {$ELSE}
  mov ax,fnGetFTime
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
  sub dx,dx
  mov ax,DOSResult
  neg ax
@@3:
End; { h_GetFTime }

Function h_SetFTime; assembler;
Asm
@@1:
  mov cx,word ptr [DateTime]
  mov dx,word ptr [DateTime+2]
  mov bx,Handle
  mov ax,5701h { set date and time }
  mov DOSResult,dosrOk
  int DOS
  jc  @@2
  mov ax,cx
@@2:
  mov DOSResult,ax { save error code in a global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnSetFTime { store function code }
  {$ELSE}
  mov ax,fnSetFTime
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
  sub dx,dx
  mov ax,DOSResult
  neg ax
@@3:
End; { h_SetFTime }

Function h_CloseFile; assembler;
{ H_CLOSEFILE - DOS Handle file function
  Description: Closes open file; fn=3Eh
  Returns: 0 if successful, negative DOS error code otherwise }
Asm
@@1:
  mov bx,Handle
  mov ah,3Eh
  int DOS
  jc  @@2
  sub ax,ax
  mov DOSResult,dosrOk
  jmp @@3
@@2:
  mov DOSResult,ax { save error code in a global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnCloseFile { store function code }
  {$ELSE}
  mov ax,fnCloseFile
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
  mov ax,DOSResult
  neg ax
@@3:
End; { h_CloseFile }

Function DosMaxAvail;
{$IFNDEF ProtectedMode}
assembler;
{ Returns the size of the largest contiguous free memory block
  This function should be called ONLY when both HeapMin/HeapMax
  memory allocation parameters set to zero }
Asm
  mov bx,0FFFFh
  mov ah,48h
  int DOS
  mov ax,bx
  mov bx,16
  mul bx
End;
{$ELSE}
Begin
  DosMaxAvail := GetFreeSpace(0)
End; { DosMaxAvail }
{$ENDIF}

Function DosGetMem;
{$IFNDEF ProtectedMode}
assembler;
Asm
@@1:
  mov DOSResult,dosrOk
  mov ax,word ptr [Size]
  mov dx,word ptr [Size+2]
  mov cx,16
  div cx
  inc ax
  mov bx,ax
  mov ah,48h
  int DOS
  jnc @@2
  mov DOSResult,ax { save error code in a global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnDosGetMem { store function code }
  {$ELSE}
  mov ax,fnDosGetMem
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
  sub ax,ax
@@2:
  mov dx,ax
  sub ax,ax
End;
{$ELSE}
Begin
  DosGetMem := GlobalAllocPtr(gmem_ZeroInit or gmem_Moveable, Size)
End; { DosGetMem }
{$ENDIF}

Function DosFreeMem;
{$IFNDEF ProtectedMode}
assembler;
Asm
  mov DOSResult,dosrOk
  mov es,word ptr [P+2]
  mov ah,49h
  int DOS
  jnc @@1
  mov DOSResult,ax
  push ax
  {$IFOPT G+}
  push fnDosFreeMem { store function code }
  {$ELSE}
  mov ax,fnDosFreeMem
  push ax
  {$ENDIF}
  call ErrorHandler
@@1:
  mov ax,DOSResult
  neg ax
End;
{$ELSE}
Begin
  DosFreeMem := GlobalFreePtr(P)
End; { DosFreeMem }
{$ENDIF}

Function DosResize;
{$IFNDEF ProtectedMode}
assembler;
Asm
@@1:
  mov DOSResult,dosrOk
  mov ax,word ptr [NewSize]
  mov dx,word ptr [NewSize+2]
  mov cx,16
  div cx
  inc ax
  mov bx,ax
  mov ah,4Ah
  int DOS
  jnc @@2
  mov DOSResult,ax { save error code in a global variable }
  push ax     { store error code }
  {$IFOPT G+}
  push fnDosResize { store function code }
  {$ELSE}
  mov ax,fnDosResize
  push ax
  {$ENDIF}
  call ErrorHandler
  cmp al,frRetry
  je  @@1
  sub ax,ax
@@2:
  mov dx,ax
  sub ax,ax
End;
{$ELSE}
Begin
  DosResize := GlobalReallocPtr(P, NewSize, gmem_ZeroInit or gmem_Moveable)
End; { DosResize }
{$ENDIF}

{$IFNDEF ProtectedMode}
Procedure Keep; assembler;
Asm
  mov ah,31h
  mov al,ExitCode
  mov ax,word ptr [Size]
  mov dx,word ptr [Size+2]
  mov cx,16
  div cx
  inc ax
  mov dx,ax
  int DOS
End; { Keep }
{$ENDIF}

{$IFNDEF Windows}
Procedure StdOutText; assembler;
{ Displays a given PChar-type string at the standard output device.
  h_Write to hStdOutput device function is used to provide whole string
  output }
Asm
  push ds
  lds dx,Str
  push ds
  push dx
  call StrLen
  mov cx,ax
  mov bx,hStdOutput
  mov ah,40h
  int DOS
  pop ds
End; { StdOutText }

Procedure StdOutTextLF; assembler;
{ Calls StdOutText to display a string, and then moves caret/cursor
  to a new line (CR + LF) }
Asm
  les di,Str
  push es
  push di
  call StdOutText
  mov ah,02h
  mov dl,0Dh
  int DOS
  mov dl,0Ah
  int DOS
End; { StdOutTextLF }

Procedure StdOutText_; assembler;
Asm
  push ds
  lds si,Str
  cld
  sub ax,ax
  lodsb
  mov cx,ax
  mov dx,si
  mov bx,hStdOutput
  mov ah,40h
  int DOS
  pop ds
End; { StdOutText_ }

Procedure StdOutTextLF_; assembler;
Asm
  les di,Str
  push es
  push di
  call StdOutText_
  mov ah,02h
  mov dl,0Dh
  int DOS
  mov dl,0Ah
  int DOS
End; { StdOutTextLF_ }

Procedure StdInpText; assembler;
Asm
  push ds
  lea bx,TempStr
  push es
  push bx
  push es
  push bx
  push word ptr [MaxLength]
  call StdInpText_
  pop si
  pop ds
  les di,Str
  push es
  push di
  push ds
  push si
  call StrPCopy
  pop ds
End; { StdInpText }

Procedure StdInpText_; assembler;
{ Buffered String Input is performed on Str from a standard console device }
Asm
  push ds
  lds dx,Str
  mov ah,0Ah
  mov bl,MaxLength
  inc bl
  mov di,dx
  mov byte ptr [ds:di],bl
  int DOS
  lds si,Str
  les di,Str
  cld
  lodsb
  mov cl,byte ptr [ds:si]
  movsb
  sub ch,ch
  jcxz @@1
  rep movsb
@@1:
  pop ds
End; { StdInpText_ }

{$ENDIF}

Function FileSearch; assembler;
{ FileSearch searches for the file given by Name in the list of }
{ directories given by List. The directory paths in List must   }
{ be separated by semicolons. The search always starts with the }
{ current directory of the current drive. If the file is found, }
{ FileSearch stores a concatenation of the directory path and   }
{ the file name in Dest. Otherwise FileSearch stores an empty   }
{ string in Dest. The maximum length of the result is defined   }
{ by the fsPathName constant. The returned value is Dest.       }
Asm
  push ds
  cld
  lds si,List
  les di,Dest
  mov cx,fsPathName
@@1:
  push ds
  push si
  jcxz @@3
  lds si,Name
@@2:
  lodsb
  or  al,al
  je  @@3
  stosb
  loop @@2
@@3:
  sub al,al
  stosb
  les di,Dest
  mov ax,4300H
  call AnsiDosFunc
  pop si
  pop ds
  jc  @@4
  test cx,18H
  je  @@9
@@4:
  les di,Dest
  mov cx,fsPathName
  sub ah,ah
  lodsb
  or  al,al
  je  @@8
@@5:
  cmp al,';'
  je  @@7
  jcxz @@6
  mov ah,al
  stosb
  dec cx
@@6:
  lodsb
  or  al,al
  jne @@5
  dec si
@@7:
  jcxz @@1
  cmp ah,':'
  je  @@1
  mov al,'\'
  cmp al,ah
  je  @@1
  stosb
  dec cx
  jmp @@1
@@8:
  stosb
@@9:
  mov ax,word ptr [Dest]
  mov dx,word ptr [Dest+2]
  pop ds
End; { FileSearch }

Function FileExpand; assembler;
{ FileExpand fully expands the file name in Name, and stores    }
{ the result in Dest. The maximum length of the result is       }
{ defined by the fsPathName constant. The result is an all    }
{ upper case string consisting of a drive letter, a colon, a    }
{ root relative directory path, and a file name. Embedded '.'    }
{ and '..' directory references are removed, and all name and    }
{ extension components are truncated to 8 and 3 characters. The }
{ returned value is Dest.                            }
Asm
  push ds
  cld
  lds si,Name
  lea di,TempStr
  push ss
  pop es
  lodsw
  or  al,al
  je  @@1
  cmp ah,':'
  jne @@1
  cmp al,'a'
  jb  @@2
  cmp al,'z'
  ja  @@2
  sub al,20H
  jmp @@2
@@1:
  dec si
  dec si
  mov ah,19H
  int DOS
  add al,'A'
  mov ah,':'
@@2:
  stosw
  cmp [si].Byte,'\'
  je  @@3
  sub al,'A'-1
  mov dl,al
  mov al,'\'
  stosb
  push ds
  push si
  mov ah,47H
  mov si,di
  push es
  pop ds
  int DOS
  pop si
  pop ds
  jc  @@3
  sub al,al
  cmp al,es:[di]
  je  @@3
{$IFDEF Windows}
  push es
  push es
  push di
  push es
  push di
  call OemToAnsi
  pop es
{$ENDIF}
  mov cx,0FFFFH
  sub al,al
  cld
  repne    scasb
  dec di
  mov al,'\'
  stosb
@@3:
  mov cx,fsFileName
@@4:
  lodsb
  or  al,al
  je  @@7
  cmp al,'\'
  je  @@7
  cmp al,'.'
  je  @@6
  jcxz @@4
  dec cx
{$IFNDEF Windows}
  cmp al,'a'
  jb  @@5
  cmp al,'z'
  ja  @@5
  sub al,20H
{$ENDIF}
@@5:
  stosb
  jmp @@4
@@6:
  mov cl,3
  jmp @@5
@@7:
  cmp es:[di-2].Word,'.\'
  jne @@8
  dec di
  dec di
  jmp @@10
@@8:
  cmp es:[di-2].Word,'..'
  jne @@10
  cmp es:[di-3].Byte,'\'
  jne @@10
  sub di,3
  cmp es:[di-1].Byte,':'
  je  @@10
@@9:
  dec di
  cmp es:[di].Byte,'\'
  jne @@9
@@10:
  mov cl,fsFileName
  or  al,al
  jne @@5
  cmp es:[di-1].Byte,':'
  jne @@11
  mov al,'\'
  stosb
@@11:
  lea si,TempStr
  push ss
  pop ds
  mov cx,di
  sub cx,si
  cmp cx,fsPathName
  jbe @@12
  mov cx,fsPathName
@@12:
  les di,Dest
  push es
  push di
{$IFDEF Windows}
  push es
  push di
{$ENDIF}
  rep movsb
  sub al,al
  stosb
{$IFDEF Windows}
  call AnsiUpper
{$ENDIF}
  pop ax
  pop dx
  pop ds
End; { FileExpand }

{$W+}
Function FileSplit;
{ FileSplit splits the file name specified by Path into its     }
{ three components. Dir is set to the drive and directory path  }
{ with any leading and trailing backslashes, Name is set to the }
{ file name, and Ext is set to the extension with a preceding   }
{ period. If a component string parameter is NIL, the           }
{ corresponding part of the path is not stored. If the path     }
{ does not contain a given component, the returned component    }
{ string is empty. The maximum lengths of the strings returned  }
{ in Dir, Name, and Ext are defined by the fsDirectory,         }
{ fsFileName, and fsExtension constants. The returned value is  }
{ a combination of the fcDirectory, fcFileName, and fcExtension }
{ bit masks, indicating which components were present in the    }
{ path. If the name or extension contains any wildcard          }
{ characters (* or ?), the fcWildcards flag is set in the       }
{ returned value.                                               }
var
  DirLen, NameLen, Flags : word;
  NamePtr, ExtPtr : PChar;
begin
  NamePtr := StrRScan(Path, '\');
  if NamePtr = nil then NamePtr := StrRScan(Path, ':');
  if NamePtr = nil then NamePtr := Path else Inc(NamePtr);
  ExtPtr := StrScan(NamePtr, '.');
  if ExtPtr = nil then ExtPtr := StrEnd(NamePtr);
  DirLen := NamePtr - Path;
  if DirLen > fsDirectory then DirLen := fsDirectory;
  NameLen := ExtPtr - NamePtr;
  if NameLen > fsFilename then NameLen := fsFilename;
  Flags := 0;
  if (StrScan(NamePtr, '?') <> nil) or (StrScan(NamePtr, '*') <> nil) then
    Flags := fcWildcards;
  if DirLen <> 0 then Flags := Flags or fcDirectory;
  if NameLen <> 0 then Flags := Flags or fcFilename;
  if ExtPtr[0] <> #0 then Flags := Flags or fcExtension;
  if Dir <> nil then StrLCopy(Dir, Path, DirLen);
  if Name <> nil then StrLCopy(Name, NamePtr, NameLen);
  if Ext <> nil then StrLCopy(Ext, ExtPtr, fsExtension);
  FileSplit := Flags;
End; { FileSplit }
{$W-}

Function DefaultErrorProc(ErrCode : integer; FuncCode : word) : byte; far; assembler;
{ Default error handler procedure called from EnhDOS functions }
Asm
  sub al,al   { mov al,frOk }
End; { DefaultErrorProc }

const WrongDOSVersion : PChar = 'DOS 3.1 or greater required.'#13#10'$';

Begin
  asm
    call GetDosVersion
    xchg ah,al
    cmp ax,0300h
    jg  @continue { if greater than 3.0 then continue, else exit }
    lds dx,WrongDOSVersion
    mov ah,09h
    int DOS
  @halt:
    mov ah,4Ch
    int DOS
  @continue:
    {$IFOPT G+}
    push seg [DefaultErrorProc]
    push offset [DefaultErrorProc]
    {$ELSE}
    mov ax,seg [DefaultErrorProc]
    push ax
    mov ax,offset [DefaultErrorProc]
    push ax
    {$ENDIF}
    call SetErrorHandler { set default error handler }
    mov DOSResult,dosrOk
  end;
End. { EnhDOS+ }
*